home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #13 (Oct 86) / forth source / Key.remap next >
Text File  |  1986-08-02  |  2KB  |  118 lines
  1. ( Keyboard reconfigurator, c 1986 J. Langowski / MacTutor )
  2. ( For reconfiguration of individual keys without using the Localizer )
  3.  
  4. only forth also assembler also mac
  5.  
  6. hex
  7. 494e4954 constant "init
  8. 21e constant keyb.type  ( B: Mac+ )
  9. variable hand0  variable hand1
  10.  
  11. : get.handles
  12.     "init 0 call getresource hand0 !
  13.     "init 1 call getresource hand1 !
  14. ;
  15.  
  16. : get.key1.data ( | handle start.of.data )
  17.     hand0 @ dup @ 7fffff and 14 + 
  18.         keyb.type c@ B <> if C + then  dup w@ +
  19. ;
  20.  
  21. : get.key2.data ( | handle start.of.data )
  22.     hand1 @ dup @ 7fffff and 6 + dup w@ +
  23.         keyb.type c@ B <> if 40 + then  
  24. ;
  25.     
  26. : keyin
  27.     begin 2d emit 8 emit ?terminal ?dup until
  28. ;
  29.  
  30. : keycode ( extracts keycode out of keyinfo )
  31.     100 / ff and ;
  32.  
  33. : modifiers ( extracts modifiers from keyinfo )
  34.     1000000 / ff and ;
  35.  
  36. : keyaddress { | mods keyc -- handle offset }
  37.     dup  modifiers -> mods  keycode -> keyc
  38.     keyc 41 < if get.key1.data 
  39.             dup mods E and + w@ + keyc + 
  40.           else get.key2.data 
  41.             mods 2 and
  42.             if ( shift key down) 20 + then
  43.             keyc 1f and +
  44.           then
  45. ;
  46.  
  47. : keytest
  48.     begin keyin keyaddress c@ emit key drop drop again 
  49. ;
  50.  
  51.  
  52. : get&show ( | handle offset )
  53.     keyin dup key emit ."  - Keycode = " 
  54.     dup modifiers swap keycode . 
  55.     ." , Modifiers = " binary 
  56.     <# # # # # #> type decimal 
  57.     keyaddress dup c@ 
  58.     ." , actual mapping - " emit cr
  59. ;
  60.  
  61. : keynum cr 
  62.     begin get&show drop drop again
  63. ;
  64.  
  65. decimal
  66.  
  67. : hello 
  68.     cls
  69.     ." Macintosh Keyboard Remapper" cr
  70.     ." © 1986 J.Langowski / MacTutor" cr cr
  71.     ." Closing the window will update the resource file." cr cr
  72. ;
  73.  
  74. : yesno begin key dup emit 
  75.         case 
  76.         89 of 1 1 endof  121 of 1 1 endof
  77.         78 of 0 1 endof  110 of 0 1 endof
  78.         cr ." y or n - " 0 swap
  79.         endcase
  80.       until
  81. ;        
  82.  
  83. : on.goaway 0 call updateresfile bye ;
  84.     
  85. : remap
  86.     hello 
  87.     get.handles
  88.     begin
  89.         ." Type the key you'd like to change - " cr
  90.         get&show ( | handle offset )
  91.         ." Do you want to remap this key (y/n) - " yesno cr
  92.         if 
  93.             ." Enter the character to map this key to - "
  94.             key dup emit cr 
  95.             swap c! ( store in mapping table of INIT resource)
  96.             call changedresource
  97.         else 2drop
  98.         then cr
  99.     again
  100. ;
  101.  
  102. 164 user goaway-hook
  103.  
  104. NEW.WINDOW remapper
  105. " Keyboard Configuration Editor" remapper TITLE
  106. 50 20 316 496 remapper BOUNDS
  107. ROUNDED VISIBLE CLOSEBOX NOGROWBOX remapper ITEMS
  108. 600 5000 terminal mapper
  109.  
  110. : go.map activate remap ;
  111.  
  112. : start
  113.     remapper add
  114.     remapper mapper build
  115.     ['] on.goaway goaway-hook task-> mapper !
  116.     remapper dup call selectwindow call setport
  117.     mapper go.map
  118. ;